home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitops / printafm.ps < prev    next >
Text File  |  1991-01-25  |  3KB  |  137 lines
  1. %!
  2. % $Header: /usr/jjc/dvitops/RCS/printafm.ps,v 1.1 89/02/01 09:19:41 jjc Rel $
  3. % written by James Clark <jjc@jclark.uucp>
  4. % print an afm file on the standard output
  5. % usage is `fontname printafm' eg `/Times-Roman printafm'
  6.  
  7. /buf 256 string def
  8. /onechar 1 string def
  9. /box 4 array def
  10.  
  11. % c toupper - c
  12. /toupper {
  13.     dup dup 8#141 ge exch 8#172 le and { 
  14.         8#40 sub
  15.     } if
  16. } bind def
  17.  
  18.  
  19. % dict printinfo -
  20. /printinfo {
  21.     /FontInfo get {
  22.         exch
  23.         buf cvs dup dup 0 get 0 exch toupper put print
  24.         ( ) print
  25.         buf cvs =
  26.     } forall
  27. } bind def
  28.  
  29. % dict printbbox -
  30.  
  31. /printbbox {
  32.     (FontBBox) print
  33.     /FontBBox get {
  34.         ( ) print
  35.         round cvi buf cvs print
  36.     } forall
  37.     (\n) print
  38. } bind def
  39.     
  40. % dict printcharmetrics -
  41.  
  42. /printcharmetrics {
  43.     /d exch def
  44.     (StartCharMetrics ) print
  45.     d /CharStrings get dup length exch /.notdef known { 1 sub } if =
  46.     d 1000 scalefont setfont 0 0 moveto
  47.     /e d /Encoding get def
  48.     0 1 255 {
  49.         dup e exch get
  50.         dup /.notdef ne {
  51.             exch dup printmetric
  52.         } {
  53.             pop pop
  54.         } ifelse
  55.     } for
  56.     % s contains an entry for each name in the original encoding vector
  57.     /s 256 dict def
  58.     e {
  59.         s exch true put
  60.     } forall
  61.     % v is the new encoding vector
  62.     /v 256 array def
  63.     0 1 255 {
  64.         v exch /.notdef put
  65.     } for
  66.     % fill up v with names in CharStrings
  67.     /i 0 def
  68.     d /CharStrings get {
  69.         pop
  70.         i 255 le {
  71.             v i 3 -1 roll put
  72.             /i i 1 add def
  73.         } {
  74.             pop
  75.         } ifelse
  76.     } forall
  77.     % define a new font with v as its encoding vector
  78.     d maxlength dict /f exch def
  79.     d {
  80.         exch dup dup /FID ne exch /Encoding ne and { 
  81.             exch f 3 1 roll put
  82.         } { 
  83.             pop pop 
  84.         } ifelse
  85.     } forall
  86.     f /Encoding v put
  87.     f /FontName /temp put
  88.     % make this new font the current font
  89.     /temp f definefont /d exch def
  90.     d 1000 scalefont setfont
  91.     % print a entry for each character not in old vector
  92.     /e d /Encoding get def
  93.     0 1 255 {
  94.         dup e exch get
  95.         dup dup /.notdef ne exch s exch known not and { 
  96.             exch -1 printmetric
  97.         } { 
  98.             pop pop
  99.         } ifelse
  100.     } for
  101.     (EndCharMetrics) =
  102. } bind def
  103.  
  104. % name actual_code normal_code printmetric -
  105.  
  106. /printmetric {
  107.     /saved save def
  108.     (C ) print
  109.     buf cvs print
  110.     ( ; WX ) print
  111.     onechar 0 3 -1 roll put
  112.     onechar stringwidth pop round cvi buf cvs print
  113.     ( ; N ) print
  114.     buf cvs print
  115.     ( ; B ) print
  116.     onechar false charpath flattenpath pathbbox box astore {
  117.         round cvi buf cvs print
  118.         ( ) print
  119.     } forall
  120.     (;) =
  121.     saved restore
  122. } bind def
  123.  
  124. % fontname printafm -
  125.  
  126. /printafm {
  127.     findfont /d exch def
  128.     (StartFontMetrics 2.0) =
  129.     (FontName ) print d /FontName get =
  130.     d printinfo
  131.     d printbbox
  132.     d printcharmetrics
  133.     (EndFontMetrics) =
  134. } bind def
  135.  
  136.  
  137.